home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Diamond Collection / The Diamond Collection (Software Vault)(Digital Impact).ISO / cdr47 / alt_lan.zip / DYLAN.ASC < prev    next >
Text File  |  1995-02-02  |  5KB  |  168 lines
  1. _THE DYLAN PROGRAMMING LANGUAGE_
  2. by Tamme D. Bowen and Kelly M. Hall
  3.  
  4. Example 1: 
  5.  
  6. (a)
  7.  
  8. IsClass :: ClassName -> ClassList -> Boolean
  9. IsClass (cl:ClassName) ([]:ClassList) = False
  10. IsClass cl (c::cs) =
  11.    if cl = c.name then True else IsClass cl cs
  12.  
  13. (b) 
  14.  
  15. GetSlots :: ClassName -> ClassList -> SlotList
  16. GetSlots (cl:ClassName) ([]:ClassList) = error "class not found"
  17. GetSlots cl (c::cs) =
  18.    if cl = c.name then c.sl also GetSlots cl cs
  19.  
  20. (c)
  21.  
  22. GetKids :: ClassName -> ClassList -> ClassList
  23. GetKids (cl:ClassName) ([]:ClassList) = error "class not found"
  24. GetKids cl (c::cs) =
  25.    if cl = c.name then c.subclasses else GetKids cl cs
  26.  
  27. (d) 
  28. GetSupers :: ClassName -> ClassList ->  ClassList -> ClassList 
  29. GetSupers (cl:ClassName) ([]:ClassList) = (CC:ClassList) = []
  30. GetSupers cl (c::cs) CC =
  31.    if element cl = c.subclasses 
  32.      then unique ((cl.name::GetSupers cl cs CC)@(GetSupers c.name CC CC))
  33.      else GetSupers cl cs CC
  34.  
  35. (e)
  36.  
  37. GetSubs :: ClassName -> ClassList ->  ClassList -> ClassList 
  38. GetSubs (cl:ClassName) ([]:ClassList) = (CC:ClassList) = []
  39. GetSubs cl (c::cs) CC =
  40.    if cl = c.name
  41.       then unique (direct @ indirect)
  42.       else GetSupers cl cs CC
  43. where direct = c.subclasses
  44. and   indirect = fold '@' (map (\x. GetSubs x CC CC) c.subclasses)
  45.  
  46.  
  47. Example 2: 
  48.  
  49. (a)
  50.  
  51. NewClass :: ClassName -> ClassList -> SlotList -> ClassList -> ClassList 
  52. NewClass (n:ClassName) (pl:ClassList) (sl:SlotsList) (C:ClassList) =
  53.    if IsClass n C
  54.       then NewClass n pl sl (remove n C)
  55.       else if fold and (map (\x. IsClass x C) pl)
  56.            then FixLinks n pl (n,pl,sl)::C
  57.            else error "superclass does not exist"
  58. (b)
  59.  
  60. FixLinks :: ClassName -> ClassList -> ClassList -> ClassList 
  61. FixLinks (n:ClassName) ([]:ClassList) (CC:ClassList) = CC
  62. FixLinks n (p::ps) CC = FixLinks n ps (Update n p CC)
  63.  
  64. Update :: ClassName -> ClassName -> ClassList -> ClassList 
  65. Update (n:ClassName) (p:ClassName) ([]:ClassList) = error
  66. Update n p (c:cs) =
  67.    if p = c.name
  68.      then (c.name, c.sl, n::c.subclasses)::CS
  69.      else c::(Update n p cs)
  70.  
  71. (c)
  72.  
  73. Make :: ClassName -> ClassList -> Instance
  74. Make (n:ClassName) (CL:ClassList) =
  75.    if IsClass n CL
  76.    then BuildRecord unique (localslots @ superslots)
  77.    else error "class not found"
  78. where localslots = GetSlots n CL
  79. and   superslots = fold '@' (map GetSlots (GetSupers n CL))
  80.  
  81.  
  82.  
  83. Example 3: 
  84.  
  85.  
  86.  
  87. (a) 
  88.  
  89. IsGF :: FunNames -> GFList -> Boolean
  90. IsGF (n:FunName) ([]:FGList) = False
  91. IsGF n (g:gs) =
  92.     if n = g.name then True else IsGF n gs
  93.  
  94. (b)
  95.  
  96. AddMethod :: FunName -> ParamList -> Key -> GFList -> GFList
  97. AddMethod (n:FunName) (pl:ParamList) (key:Key) ([]GFList) = []
  98. AddMethod n pl key (g:gs) =
  99.    if n = g.name
  100.        then ((g.name),(pl.key)::(g.methods)) :: gs
  101.        else g :: AddMethod n pl key gs
  102.  
  103. (c)
  104.  
  105. RemoveMethod :: FunName -> ParamList -> GFList -> GFList
  106. RemoveMethod (n:FunName) (pl:ParamList) ([]GFList) = error
  107. RemoveMethod n pl key (g:gs) =
  108.    if n = g.name
  109.        then (g.name,(RMAux pl g.methods)) :: gs
  110.        else g :: RemoveMethod n pl key gs
  111.  
  112. RMAux :: ParamList -> MethodList -> MethodList 
  113. RMAux (n:ParamList) ([]:MethodList) = error
  114. RMAux pl key (m:ms) =
  115.    if foreach i in pl (pl.i.type = m.pl.i.type)
  116.        then ms
  117.        else m :: RMAux pl ms
  118.  
  119. (d)
  120.  
  121. NewGF :: FunName -> GFList -> GFList
  122. NewGF (n:FunName) (GF:GFList) =
  123.    if IsGF n GF
  124.       then NewGF n (RemoveGF n GF)
  125.       else (n,[]) :: GF
  126.  
  127. (e)
  128.  
  129. RemoveGF :: FunName -> GFList -> GFList
  130. RemoveGF (n:FunName) ([]:GFList) = error
  131. RemoveGF n (g:gs) =
  132.    if n = g.name      then gs
  133.      else g:: RemoveGF n gs
  134.  
  135. (f)
  136.  
  137. ApplyGF :: FunName -> ParamList -> GFList -> Object
  138. ApplyGF (n:FunName) (pl:ParamList) ([]:GFList) = error
  139. ApplyGF n pl (g:gs) =
  140.    if n = g.name
  141.       then SchemeApply (SpecificMethod pl g.methods) pl
  142.       else ApplyGF n pl gs
  143.  
  144.  
  145. Example 4:
  146.  
  147. NewMethod (n:FunName) (pl:ParamList) (l:Expr) (GF:GFList) (SE:Env) =
  148. let key = MkUniqueKey GF in
  149. if IsGF n GF
  150.   then (AddMethod n pl key GF) , (bind key l SE)
  151.   else NewMethod n pl l (AddMethod n [] Nil GF)
  152.  
  153.  
  154. Example 5: 
  155.  
  156. (define-method newtons-sqrt (x)
  157.    (bind-methods ((sqrt1 (guess)
  158.                    (if (close? guess)
  159.                        guess
  160.                        (sqrt1 (improve guess))))
  161.                    (close? (guess)
  162.                        (< (abs (- (* guess guess) x)) 0.0001))
  163.                    (improve (guess)
  164.                        (/ (+ guess (/ x guess)) 2)))
  165.   (sqrt1 1)))
  166.  
  167.  
  168.